home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d17 / printpas.arc / PRINTPAS.PAS < prev   
Pascal/Delphi Source File  |  1991-04-27  |  4KB  |  139 lines
  1. { PrintPas, a Pascal source file printer }
  2. { by Benjamin L. Combee }
  3. { Copyright 1991, Alpha-One Software }
  4.  
  5. { -------------------------------------------------------------------
  6.   Features:  Prints files a 8 lines per inch and 12 cpi to fit more
  7.   on a page, skips perferations on printer paper, indents lines to
  8.   allow for hole punching, prints header line and procedure and
  9.   function headings in boldface, accepts filename from either command
  10.   line or from user prompt.
  11.   ------------------------------------------------------------------- }
  12.  
  13. PROGRAM PrintPas (INPUT, OUTPUT);
  14.  
  15. USES Printer;
  16.  
  17. CONST { Page specifics }
  18.  
  19.   LinesPerPage = 88;
  20.   BottomMargin = 8;
  21.  
  22. CONST { Printer codes }
  23.  
  24.   ResetPrn = #27 + '@';
  25.   SetElite = #27 + 'M';
  26.   Set8LPI = #27 + '0';
  27.   SetBold = #27 + 'G';
  28.   ResetBold = #27 + 'H';
  29.   FormFeed = #12;
  30.  
  31. TYPE
  32.     t_FileName = STRING [80];
  33.  
  34. { -------------------------------------------------------------------
  35.   Banner prints a welcome message and copyright notice.
  36.   ------------------------------------------------------------------- }
  37.  
  38. PROCEDURE Banner;
  39.  
  40.   BEGIN
  41.     WriteLn;
  42.     WriteLn ('PrintPAS -- a Pascal source code printing program');
  43.     WriteLn ('by Benjamin L. Combee.  Copyright 1991, Alpha-One Software.');
  44.     WriteLn;
  45.   END;
  46.  
  47. { -------------------------------------------------------------------
  48.   GetFile either prompts for a filename, or accepts a command line
  49.   parameter.  If there are more than one entry on the command line,
  50.   it ignores it and prompts for the file.
  51.   ------------------------------------------------------------------- }
  52.  
  53. FUNCTION GetFile: t_FileName;
  54.  
  55.   VAR
  56.     FileName: t_FileName;
  57.  
  58.   BEGIN
  59.     IF ParamCount = 1 THEN
  60.       FileName := ParamStr (1)
  61.     ELSE
  62.       BEGIN
  63.         FileName := '';
  64.         WHILE (FileName = '') DO
  65.           BEGIN
  66.             Write ('Enter filename: ');
  67.             ReadLn (FileName);
  68.           END;
  69.       END;
  70.     GetFile := FileName;
  71.   END;
  72.  
  73. { -------------------------------------------------------------------
  74.   PrintFile reads a file in line by line, keeping track of page
  75.   numbers, margins, and continuations.  If it finds a Pascal reserved
  76.   word in the line, it will print the word in bold.
  77.   ------------------------------------------------------------------- }
  78.  
  79. PROCEDURE PrintFile (FileName: t_FileName);
  80.  
  81.   VAR
  82.     CurrentLine, CurrentPage: INTEGER;
  83.     TextLine: STRING [96];
  84.     T: Text;
  85.  
  86.   BEGIN
  87.  
  88.     { Set to first line, first page }
  89.  
  90.     CurrentLine := 1;
  91.     CurrentPage := 1;
  92.  
  93.     { Now, print the pages }
  94.  
  95.     Assign (T, FileName);
  96.     Reset (T);
  97.  
  98.     Write (Lst, ResetPrn, SetElite, Set8LPI);
  99.  
  100.     WHILE NOT EOF (T) DO
  101.       BEGIN
  102.         IF CurrentLine = 1 THEN
  103.           BEGIN
  104.             Write (Lst, SetBold, '       (', FileName, '     p. ');
  105.             WriteLn (Lst, CurrentPage, ')', ResetBold);
  106.           END
  107.         ELSE IF (CurrentLine = 2) OR
  108.                 (CurrentLine > (LinesPerPage - BottomMargin)) THEN
  109.           WriteLn (Lst)
  110.         ELSE
  111.           BEGIN
  112.             ReadLn (T, TextLine);
  113.             Insert ('       ', TextLine, 1);
  114.             IF (Pos ('FUNCTION', TextLine) <> 0) OR
  115.                (Pos ('PROCEDURE', TextLine) <> 0) THEN
  116.               WriteLn (Lst, SetBold, TextLine, ResetBold)
  117.             ELSE
  118.               WriteLn (Lst, TextLine);
  119.           END;
  120.         Inc (CurrentLine);
  121.         IF CurrentLine > LinesPerPage THEN
  122.           BEGIN
  123.             CurrentLine := 1;
  124.             Inc (CurrentPage);
  125.           END;
  126.       END;
  127.  
  128.     Write (Lst, FormFeed, ResetPrn);
  129.     Close (T);
  130.  
  131.   END;
  132.  
  133. { ------------------------------------------------------------------- }
  134.  
  135. BEGIN
  136.   Banner;
  137.   PrintFile (GetFile);
  138. END.
  139.